home *** CD-ROM | disk | FTP | other *** search
/ Trading on the Edge / Trading On The Edge - CD-ROM Toolkit (Wayzata Technology)(2031)(1994).bin / pc / shared / freeman / backprop.m < prev    next >
Text File  |  1993-10-27  |  10KB  |  232 lines
  1. BeginPackage["Backpropagation`"]
  2.  
  3. sigmoid::usage = "sigmoid[x,opts___Rule]"
  4. bpnTest::usage = "bpnTest[hiddenWts,outputWts,ioPairVectors,opts___Rule]"
  5. bpnStandard::usage = "bpnStandard[inNumber, hidNumber, outNumber,ioPairs, eta, numIters]"
  6. bpnBias::usage = "bpnBias[inNumber, hidNumber, outNumber,ioPairs, eta, numIters]"
  7. bpnMomentum::usage = "bpnMomentum[inNumber,hidNumber,outNumber,ioPairs,eta,
  8.      alpha,numIters]"
  9. bpnMomentumSmart::usage = "bpnMomentumSmart[inNumber,hidNumber,outNumber,ioPairs,eta,
  10.                 alpha,numIters]"
  11. bpnCompete::usage = "bpnCompete[inNumber,hidNumber,outNumber,ioPairs,eta,numIters]"
  12.  
  13.  
  14. Begin["`Private`"]    (* begin the private context *)
  15.  
  16.  
  17. Options[sigmoid] = {xShift->0,yShift->0,temperature->1};
  18. Options[bpnTest] = {printAll->False,bias->False};
  19.  
  20. sigmoid[x_,opts___Rule] :=
  21.     Module[{xshft,yshft,temp},
  22.         xshft = xShift /. {opts} /. Options[sigmoid];
  23.         yshft = yShift /. {opts} /. Options[sigmoid];
  24.         temp = temperature /. {opts} /. Options[sigmoid];
  25.         yshft+1/(1+E^(-(x-xshft)/temp)) //N
  26.         ]
  27.  
  28. bpnTest[hiddenWts_,outputWts_,ioPairVectors_,opts___Rule] :=
  29.   Module[{inputs,hidden,outputs,desired,errors,i,len=Length[inputs],
  30.      prntAll,errorTotal,errorSum,bias},
  31.    prntAll= printAll /. {opts} /. Options[bpnTest];
  32.    biasVal = bias /. {opts} /. Options[bpnTest];
  33.    inputs=Map[First,ioPairVectors];
  34.    If[biasVal,inputs=Map[Append[#,1.0]&,inputs] ];
  35.    desired=Map[Last,ioPairVectors];
  36.    hidden=sigmoid[inputs.Transpose[hiddenWts]];
  37.    If[biasVal,hidden = Map[Append[#,1.0]&,hidden] ];
  38.    outputs=sigmoid[hidden.Transpose[outputWts]];
  39.    errors= desired-outputs;
  40.    If[prntAll,Print["ioPairs:"];Print[ ];Print[ioPairVectors];
  41.                    Print[ ];Print["inputs:"];Print[ ];Print[inputs];
  42.                    Print[ ];Print["hidden-layer outputs:"];
  43.                    Print[hidden];Print[ ];
  44.                    Print["output-layer outputs:"];Print[ ];
  45.                    Print[outputs];Print[ ];Print["errors:"];
  46.                    Print[errors];Print[ ];  ]; (* end of If *)
  47.    For[i=1,i<=len,i++,Print[" Output ",i," = ",outputs[[i]]," desired = ",
  48.            desired[[i]]," Error = ",errors[[i]]];Print[];  ];            (* end of For *)
  49.    errorSum = Apply[Plus,errors^2,2]; (* second level *)
  50.    errorTotal = Apply[Plus,errorSum];
  51.    Print["Mean Squared Error = ",errorTotal/len];
  52.    ]                    (* end of Module *)
  53.  
  54.  
  55. bpnStandard[inNumber_, hidNumber_, outNumber_,ioPairs_, eta_, numIters_] :=
  56.   Module[{errors,hidWts,outWts,ioP,inputs,outDesired,hidOuts,
  57.               outputs, outErrors,outDelta,hidDelta},
  58.     hidWts = Table[Table[Random[Real,{-0.1,0.1}],{inNumber}],{hidNumber}];
  59.     outWts = Table[Table[Random[Real,{-0.1,0.1}],{hidNumber}],{outNumber}];
  60.     errors = Table[
  61.             (* select ioPair *)                                        
  62.       ioP=ioPairs[[Random[Integer,{1,Length[ioPairs]}]]];
  63.       inputs=ioP[[1]];
  64.       outDesired=ioP[[2]];
  65.               (* forward pass *)
  66.       hidOuts = sigmoid[hidWts.inputs];
  67.       outputs = sigmoid[outWts.hidOuts];
  68.               (* determine errors and deltas *)
  69.       outErrors = outDesired-outputs;
  70.       outDelta= outErrors (outputs (1-outputs));
  71.       hidDelta=(hidOuts (1-hidOuts)) Transpose[outWts].outDelta;
  72.               (* update weights *)
  73.       outWts += eta Outer[Times,outDelta,hidOuts];
  74.       hidWts += eta Outer[Times,hidDelta,inputs];
  75.               (* add squared error to Table *)
  76.       outErrors.outErrors,{numIters}];  (* end of Table *)
  77.     Return[{hidWts,outWts,errors}];
  78.     ];                                    (* end of Module *)
  79.  
  80.  
  81.  
  82. bpnBias[inNumber_, hidNumber_, outNumber_,ioPairs_, eta_, numIters_] :=
  83.   Module[{errors,hidWts,outWts,ioP,inputs,outDesired,hidOuts,
  84.               outputs, outErrors,outDelta,hidDelta},
  85.     hidWts = Table[Table[Random[Real,{-0.1,0.1}],{inNumber+1}],{hidNumber}];
  86.     outWts = Table[Table[Random[Real,{-0.1,0.1}],{hidNumber+1}], {outNumber}];
  87.     errorList = Table[
  88.             (* select ioPair *)                                        
  89.       ioP=ioPairs[[Random[Integer,{1,Length[ioPairs]}]]];
  90.       inputs=Append[ioP[[1]],1.0]; (* bias mod *)
  91.       outDesired=ioP[[2]];
  92.               (* forward pass *)
  93.       hidOuts = sigmoid[hidWts.inputs];
  94.       outInputs = Append[hidOuts,1.0];  (* bias mod *)
  95.       outputs = sigmoid[outWts.outInputs];
  96.               (* determine errors and deltas *)
  97.       outErrors = outDesired-outputs;
  98.       outDelta= outErrors (outputs (1-outputs));
  99.       hidDelta=(outInputs (1-outInputs)) * Transpose[outWts].outDelta;
  100.               (* update weights *)
  101.       outWts += eta Outer[Times,outDelta,outInputs];
  102.       hidWts += eta Drop[Outer[Times,hidDelta,inputs],-1];  (* bias mod *)
  103.               (* add squared error to Table *)
  104.       outErrors.outErrors,{numIters}];  (* end of Table *)
  105.       Print["New hidden-layer weight matrix: "];
  106.   Print[]; Print[hidWts];Print[];
  107.   Print["New output-layer weight matrix: "];
  108.   Print[]; Print[outWts];Print[];  
  109.   bpnTest[hidWts,outWts,ioPairs];   (* check how close we are *)
  110.   errorPlot = ListPlot[errorList, PlotJoined->True];
  111.   Return[{hidWts,outWts,errorList,errorPlot}];
  112.     ];                                    (* end of Module *)
  113.  
  114.  
  115. bpnMomentum[inNumber_,hidNumber_,outNumber_,ioPairs_,eta_,
  116.      alpha_,numIters_] :=
  117.   Module[{hidWts,outWts,ioP,inputs,hidOuts,outputs,outDesired, 
  118.     hidLastDelta,outLastDelta,outDelta,hidDelta,outErrors},
  119.     hidWts = Table[Table[Random[Real,{-0.5,0.5}],{inNumber}],{hidNumber}];
  120.     outWts = Table[Table[Random[Real,{-0.5,0.5}],{hidNumber}],{outNumber}];
  121.     hidLastDelta = Table[Table[0,{inNumber}],{hidNumber}];
  122.     outLastDelta = Table[Table[0,{hidNumber}],{outNumber}];
  123.     errorList = Table[
  124.                              (* begin forward pass *)
  125.          ioP=ioPairs[[Random[Integer,{1,Length[ioPairs]}]]];
  126.          inputs=ioP[[1]];
  127.          outDesired=ioP[[2]];
  128.          hidOuts = sigmoid[hidWts.inputs];  (* hidden-layer outputs *)
  129.          outputs = sigmoid[outWts.hidOuts]; (* output-layer outputs *)
  130.                             (* calculate errors *)
  131.          outErrors = outDesired-outputs;
  132.          outDelta= outErrors (outputs (1-outputs));
  133.          hidDelta=(hidOuts (1-hidOuts)) Transpose[outWts].outDelta;
  134.                           (* update weights *)
  135.          outLastDelta= eta Outer[Times,outDelta,hidOuts]+alpha outLastDelta;
  136.          outWts += outLastDelta;
  137.          hidLastDelta = eta Outer[Times,hidDelta,inputs]+
  138.                                alpha hidLastDelta;
  139.          hidWts += hidLastDelta;
  140.             outErrors.outErrors, (* this puts the error on the list *)
  141.             {numIters}]    ;     (* this many times, Table ends here *)
  142.   Print["New hidden-layer weight matrix: "];
  143.   Print[]; Print[hidWts];Print[];
  144.   Print["New output-layer weight matrix: "];
  145.   Print[]; Print[outWts];Print[];  
  146.   bpnTest[hidWts,outWts,ioPairs,bias->False,printAll->False];
  147.   errorPlot = ListPlot[errorList, PlotJoined->True];
  148.   Return[{hidWts,outWts,errorList,errorPlot}];
  149.   ]                        (* end of Module *)
  150.  
  151.  
  152. bpnMomentumSmart[inNumber_,hidNumber_,outNumber_,ioPairs_,eta_,
  153.                 alpha_,numIters_] :=
  154.   Module[{hidWts,outWts,ioP,inputs,hidOuts,outputs,outDesired, 
  155.              hidLastDelta,outLastDelta,outDelta,hidDelta,outErrors},
  156.     hidWts = Table[Table[Random[Real,{-0.5,0.5}],{inNumber}],{hidNumber}];
  157.     outWts = Table[Table[Random[Real,{-0.5,0.5}],{hidNumber}],{outNumber}];
  158.     hidLastDelta = Table[Table[0,{inNumber}],{hidNumber}];
  159.     outLastDelta = Table[Table[0,{hidNumber}],{outNumber}];
  160.     errorList = Table[
  161.                           (* begin forward pass *)
  162.         ioP=ioPairs[[Random[Integer,{1,Length[ioPairs]}]]];
  163.         inputs=ioP[[1]];
  164.         outDesired=ioP[[2]];
  165.         hidOuts = sigmoid[hidWts.inputs];  (* hidden-layer outputs *)
  166.         outputs = sigmoid[outWts.hidOuts]; (* output-layer outputs *)
  167.                         (* calculate errors *)
  168.         outErrors = outDesired-outputs;
  169.         If[First[Abs[outErrors]]>0.1,
  170.           outDelta= outErrors (outputs (1-outputs));
  171.           hidDelta=(hidOuts (1-hidOuts)) Transpose[outWts].outDelta;
  172.                           (* update weights *)
  173.           outLastDelta= eta Outer[Times,outDelta,hidOuts]+
  174.                                 alpha outLastDelta;
  175.           outWts += outLastDelta;
  176.           hidLastDelta = eta Outer[Times,hidDelta,inputs]+
  177.                                    alpha hidLastDelta;
  178.           hidWts += hidLastDelta,Continue]; (* end of If *)
  179.           outErrors.outErrors, (* this puts the error on the list *)
  180.           {numIters}]    ;     (* this many times, Table ends here *)
  181.   Print["New hidden-layer weight matrix: "];
  182.   Print[]; Print[hidWts];Print[];
  183.   Print["New output-layer weight matrix: "];
  184.   Print[]; Print[outWts];Print[];  
  185.   bpnTest[hidWts,outWts,ioPairs,bias->False,printAll->False];
  186.   errorPlot = ListPlot[errorList, PlotJoined->True];
  187.   Return[{hidWts,outWts,errorList,errorPlot}];
  188.   ]                        (* end of Module *)
  189.  
  190.  
  191. bpnCompete[inNumber_,hidNumber_,outNumber_,ioPairs_,eta_,numIters_] :=
  192.  Module[{hidWts,outWts,ioP,inputs,hidOuts,outputs,outDesired, 
  193.              outInputs,hidEps,outEps,outDelta,hidPos, outPos, hidDelta,outErrors},
  194.   hidWts = Table[Table[Random[Real,{-0.5,0.5}],{inNumber}]{hidNumber}];
  195.   outWts = Table[Table[Random[Real,{-0.5,0.5}],{hidNumber}],{outNumber}];
  196.   errorList = Table[    (* begin forward pass *)
  197.   ioP=ioPairs[[Random[Integer,{1,Length[ioPairs]}]]];
  198.      inputs=ioP[[1]]; 
  199.      outDesired=ioP[[2]];
  200.      hidOuts = sigmoid[hidWts.inputs];
  201.      outputs = sigmoid[outWts.hidOuts]; 
  202.      outErrors = outDesired-outputs;      (* calculate errors *)
  203.      outDelta= outErrors (outputs (1-outputs));
  204.      hidDelta=(hidOuts (1-hidOuts)) Transpose[outWts].outDelta;
  205.                         (* index of max delta *)
  206.      outPos = First[Flatten[Position[Abs[outDelta],Max[Abs[outDelta]]]]];
  207.      outEps = outDelta[[outPos]];  (* max value *)
  208.      outDelta=Table[-1/4 outEps,{Length[outDelta]}]; (* new outDelta table *)
  209.      outDelta[[outPos]] = outEps;  (* reset this one  *)
  210.                     (* index of max delta *)
  211.      hidPos = First[Flatten[Position[Abs[hidDelta],Max[Abs[hidDelta]]]]];
  212.      hidEps = hidDelta[[hidPos]];  (* max value *)
  213.      hidDelta=Table[-1/4 hidEps,{Length[hidDelta]}]; (* new outDelta table *)
  214.         hidDelta[[hidPos]] = hidEps;  (* reset this one  *)
  215.      outWts +=eta Outer[Times,outDelta,hidOuts];
  216.      hidWts += eta Outer[Times,hidDelta,inputs];
  217.         outErrors.outErrors, (* this puts the error on the list *)
  218.         {numIters}]    ;     (* this many times, Table ends here *)
  219.  Print["New hidden-layer weight matrix: "];
  220.  Print[ ]; Print[hidWts];Print[ ];
  221.  Print["New output-layer weight matrix: "];
  222.  Print[ ]; Print[outWts];Print[ ];  
  223.  bpnTest[hidWts,outWts,ioPairs,bias->False,printAll->False]; 
  224.  errorPlot = ListPlot[errorList, PlotJoined->True];
  225.  Return[{hidWts,outWts,errorList,errorPlot}];
  226.  ]                        (* end of Module *)    
  227.  
  228.  
  229.  
  230. End[]         (* end the private context *)
  231.  
  232. EndPackage[]  (* end the package context *)